//*******************************************************************
// GoldenGlobe - by Vlad PARCALABIOR (vlad@ifrance.com)  01.2001
// This is a Gloss Mapping and shadows demo.
// Gloss Mapping is an improved Environment Mapping technique which
//  adds realism to reflective objects by introducing varying levels
//  of reflectivity on the object. The alpha channel of the base
//  texture contains a gloss map which attenuates the environment map
//  in the object's local texture coordinate space.
// The shadow technique I use gives a very realistic effect, but works
//  only with spheres.
//
//
// Visit http://arrowsoft.ifrance.com for more programs.
// If you use this code in your progras, please give me some credit
// or mention my website.
//*******************************************************************

unit Main;

interface

uses
  Windows, SysUtils, Forms, ExtCtrls,  Dialogs,
  OpenGL12, Geometry, GLutil, Classes;

type
  TmForm = class(TForm)
    StartTimer: TTimer;
    FPStimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure StartTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure AppMinimize(Sender: TObject);
    procedure AppRestore(Sender: TObject);
    procedure FPStimerTimer(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

      tBall= class
       ball:pGLUquadric;
       x, y, z, R: GLfloat; //coords & radius
       direction, rotaxe: tVector3f; //axe of rotation
       energy,               //energy: not used yet
       rotang: single;       //rot. angle
       tex, ID: integer;
       constructor Create(pID, ptex:integer);
       destructor Destroy; override;
       procedure Draw(reflection, shadow: boolean);
       procedure SetPos(px,py,pz: GLfloat);
      end;

const
   light0Position :tVector4f = (-20.0, 40.0, -20.0, 1.0);
   light0Ambient :tVector4f = (0.5, 0.5, 0.5, 1.0);
   light0Diffuse :tVector4f = (1.0, 1.0, 1.0, 1.0);
   light0Specular :tVector4f = (1.0, 1.0, 1.0, 1.0);

const FOV=90;
      TABLESIZEX = 70;
      TABLESIZEZ = 70;
      TABTEXX = 1;  //texture repeat in X direction
      TABTEXZ = 1;  //texture repeat in Z direction
      GRIDX = 2;  //table tesselation
      GRIDZ = 2;
      TABLEY = 0; //y coord of table surface
      lst_table=1;
      tex_table=1; tex_refl=2; tex_ball1=3; tex_shad=4;

var
  mForm: TmForm;
  DC: HDC; HRC: HGLRC;
  fullscr: tFullScreen;
  vendor,renderer,dims,gcard: string;
  animate:boolean=false;
  frametime, starttime: cardinal;
  lang: single;
  fps: word;
  ball1: tBall; lite: pGLUquadric;
  sh, ref: boolean;

implementation
{$R *.DFM}

constructor tBall.Create(pID, ptex:integer);
begin
inherited Create;
ball:=gluNewQuadric();
gluQuadricDrawStyle(ball, GLU_FILL);
gluQuadricNormals(ball, GLU_SMOOTH);
gluQuadricOrientation(ball, GLU_OUTSIDE);
gluQuadricTexture(ball, GL_TRUE);
ID:=pID;
tex:=ptex;
R:=8; x:=0.0; y:=R; z:=0.0;
rotaxe[0]:=1.0; rotaxe[1]:=0.0; rotaxe[2]:=0.0;
glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);

glNewList(ID, GL_COMPILE);
 gluSphere(ball,R,20,20);
glEndList;
end;

destructor tBall.Destroy;
begin
gluDeleteQuadric(ball);
glDeleteLists(ID, 1);
inherited Destroy;
end;

procedure tBall.Draw(reflection, shadow: boolean);
var a, a1, a2, b, dlt, dls, d1, d2, lu, su, temp, cosb, theta, alpha: single;
    vls, vlu, upos: tVector3f;
begin
if shadow then
 begin
 vls:=MakeAffineVector([x-light0Position[0], y-light0Position[1], z-light0Position[2]]);
 dls:=VectorNormalize(vls);
 a:=arctan2(R, dls);
 cosb:=abs(y-light0Position[1])/dls;
 b:=arccos(cosb);
 a1:=b+a;
 a2:=abs(b-a);
 temp:=light0Position[1]-TABLEY;
 d1:=temp*geometry.Tan(a1);
 d2:=temp*geometry.Tan(a2);
 if b>a then lu:=(d1-d2)/2
        else lu:=(d1+d2)/2;
 dlt:=temp/cosb;
 su:=dlt*(R/dls);
 vlu[0]:=vls[0];
 vlu[1]:=vls[1];
 vlu[2]:=vls[2];
 VectorScale(vlu, dlt);
 upos:=VectorAffineAdd(MakeAffineVector([light0Position[0],light0Position[1],light0Position[2]]), vlu);
 theta:=arctan2(light0Position[2]-z, light0Position[0]-x)*180/3.141592;
 //ok, I computed the shadow's center and dimensions, now I draw it:
 glPushMatrix;
  glDisable(GL_LIGHTING);
  glDisable(GL_DEPTH_TEST);

  glBindTexture(GL_TEXTURE_2D, tex_shad);
  // uncomment next line if you try GL_ONE, GL_SRC_ALPHA for the globe
  // (see globe light+base pass)
  //glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA );

  glTranslatef(upos[0], upos[1], upos[2]);
  glRotatef(-90, 1,0,0);
  glRotatef(-theta, 0,0,1);

  //now compute the shadow's alpha function of sphere's y coord
  //1= max alpha at y=R;
  //40 = y where alpha=0.
  temp:=R+TABLEY-40;
  alpha:=1/temp*y - 40/temp;
  glcolor4f(1.0,1.0,1.0,alpha);

  glBegin(GL_QUADS);         //..and this is the shadow! A textured quad.
   glTexCoord2f(0,0);
   glVertex3f(-lu, -su, 0);
   glTexCoord2f(1,0);
   glVertex3f(lu, -su, 0);
   glTexCoord2f(1,1);
   glVertex3f(lu, su, 0);
   glTexCoord2f(0,1);
   glVertex3f(-lu, su, 0);
  glEnd;

  glEnable(GL_DEPTH_TEST);
 glPopMatrix;

 glPushMatrix;
  glTranslatef(light0Position[0],light0Position[1],light0Position[2]);
  glDisable(GL_TEXTURE_2D);
  glcolor4f(0.9, 0.9, 0.7, 1);
  gluDisk(lite, 0, 1, 8, 1); //the light spot
  glEnable(GL_TEXTURE_2D);
 glPopMatrix;
 glEnable(GL_LIGHTING);
 end;


glPushMatrix;
 glTranslatef(x, y, z);
 glRotatef(rotang, rotaxe[0], rotaxe[1], rotaxe[2]);
 if reflection then
   begin
   //specular map pass
   glBindTexture(GL_TEXTURE_2D, tex_refl);
   glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
   glDisable(GL_LIGHTING);
   glDisable(GL_BLEND);

   glEnable(GL_TEXTURE_GEN_S);
   glEnable(GL_TEXTURE_GEN_T);
   glCallList(ID);
   glDisable(GL_TEXTURE_GEN_S);
   glDisable(GL_TEXTURE_GEN_T);

   //light+base pass
   glEnable(GL_LIGHTING);
   glEnable(GL_BLEND);
   glBindTexture(GL_TEXTURE_2D, tex);
   glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

   glDisable(GL_DEPTH_TEST);
   //glBlendFunc(GL_ONE, GL_SRC_ALPHA);
   glCallList(ID);
   glEnable(GL_DEPTH_TEST);
   end
 else
  begin
  glDisable(GL_BLEND);
  glBindTexture(GL_TEXTURE_2D, tex);
  glCallList(ID);
  glEnable(GL_BLEND);
  end;
glPopMatrix;
end;

procedure tBall.SetPos(px,py,pz: GLfloat);
begin
x:=px; y:=py; z:=pz;
end;


procedure ResizeViewport(width,height:longint);
 var aspect: single;
begin
aspect := width/height;
glViewport(0, 0, width, height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluPerspective(FOV/aspect, aspect, 1, 200);
glMatrixMode(GL_MODELVIEW);
end;

procedure InitLights;
begin
glLightModelf(GL_LIGHT_MODEL_LOCAL_VIEWER, 0.0);
glLightModelf(GL_LIGHT_MODEL_TWO_SIDE, 0.0);
glLightfv(GL_LIGHT0, GL_AMBIENT, @light0Ambient);
glLightfv(GL_LIGHT0, GL_DIFFUSE, @light0Diffuse);
glLightfv(GL_LIGHT0, GL_SPECULAR, @light0Specular);
glLightfv(GL_LIGHT0, GL_POSITION, @light0Position);
glEnable(GL_LIGHT0);
end;

procedure InitTextures;
var tex: tTexture;
begin
tex:=ttexture.Load(tex_table,'tableface.jpg');
glBindTexture(GL_TEXTURE_2D, tex.ID);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_NEAREST);
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, tex.width, tex.height,
                  GL_RGBA, GL_UNSIGNED_BYTE, tex.pixels);

tex.free;
tex:=ttexture.Load(tex_ball1,'ball1.tga');
glBindTexture(GL_TEXTURE_2D, tex.ID);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_NEAREST);
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, tex.width, tex.height,
                  GL_RGBA, GL_UNSIGNED_BYTE, tex.pixels);
tex.free;
tex:=ttexture.Load(tex_refl,'lightenv1.jpg');
glBindTexture(GL_TEXTURE_2D, tex.ID);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_NEAREST);
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, tex.width, tex.height,
                  GL_RGBA, GL_UNSIGNED_BYTE, tex.pixels);
tex.free;
tex:=ttexture.Load(tex_shad,'shadow.tga');
glBindTexture(GL_TEXTURE_2D, tex.ID);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_NEAREST);
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, tex.width, tex.height,
                  GL_RGBA, GL_UNSIGNED_BYTE, tex.pixels);
tex.free;

end;

procedure InitScene;
var  x, z:integer;
begin
lang:=0;
ball1:=tBall.Create(2, tex_ball1);
with ball1 do
 begin
 rotaxe[0]:=0.5; rotaxe[1]:=0.5; rotaxe[2]:=-0.5;
 SetPos(0,ball1.R,-30);
 end;

lite:=gluNewQuadric();
gluQuadricDrawStyle(lite, GLU_FILL);
gluQuadricNormals(lite, GLU_NONE);
gluQuadricOrientation(lite, GLU_OUTSIDE);
gluQuadricTexture(lite, GL_TRUE);


glNewList(lst_table,GL_COMPILE);
 glBindTexture(GL_TEXTURE_2D, tex_table);
 glNormal3f(0.0,1.0,0.0);
 glFrontFace(GL_CW);
 for z:=0 to GRIDZ - 1 do
  begin
  glBegin(GL_QUAD_STRIP);
  for x:=0 to GRIDX do
   begin
   glTexCoord2f(x/GRIDX*TABTEXX, z/GRIDZ*TABTEXZ);
   glVertex3f(x*TABLESIZEX/GRIDX-TABLESIZEX/2, TABLEY, z*-TABLESIZEZ/GRIDZ);
   glTexCoord2f(x/GRIDX*TABTEXX, (z+1)/GRIDZ*TABTEXZ);
   glVertex3f(x*TABLESIZEX/GRIDX-TABLESIZEX/2, TABLEY, (z+1)*-TABLESIZEZ/GRIDZ);
   end;
  glEnd;
  end;
 glFrontFace(GL_CCW);
glEndList;
end;

procedure DeInitScene;
begin
ball1.Free;
gluDeleteQuadric(lite);
glDeleteLists(lst_table, 1);
end;

Procedure SetupGL(whandle: HWND; width,height:longint);
begin
DC := GetDC(whandle);
HRC:=CreateRenderingContext(DC,[opDoubleBuffered],32,0,0,0,0);
ActivateRenderingContext(DC,HRC);

glClearColor(0.0, 0.0, 0.0, 1.0);
glClearDepth(1.0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glFrontFace(GL_CCW);
glShadeModel(GL_SMOOTH);
glDepthFunc(GL_LEQUAL);
glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
glAlphaFunc(GL_GEQUAL, 0.05);

glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA );

glEnable(GL_DEPTH_TEST);
glEnable(GL_CULL_FACE);
//glEnable(GL_NORMALIZE);
glEnable(GL_BLEND);
glDisable(GL_ALPHA_TEST);
glDisable(GL_COLOR_MATERIAL);
glEnable(GL_LIGHTING);
glEnable(GL_TEXTURE_2D);

glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);

ResizeViewport(width, height);
InitTextures;
InitLights;
InitScene;

gluLookAt(0,50,20,0,10,-30,0,1,0);
end;


procedure MainLoop;
var temp1, temp2: single;
begin
repeat
 starttime:=gettickcount;
 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 glCallList(lst_table);

 temp1:=cos(lang);
 temp2:=sin(lang);
 light0Position[0]:=30*temp1;
 ball1.y:=abs(15*cos(lang*5))+ball1.R; //+TABLEY, but it's 0
 light0Position[2]:=30*temp2-30;
 glLightfv(GL_LIGHT0, GL_POSITION, @light0Position);
 ball1.rotaxe[0]:=temp1; ball1.rotaxe[2]:=temp2;
 ball1.Draw(ref, sh);

 SwapBuffers(DC);
 frametime:=gettickcount-starttime;
 ball1.rotang:=ball1.rotang+(frametime/1000)*120; //deg/sec
 lang:=lang+(frametime/1000)*PI/8; //rad/sec
 inc(fps);
 Application.ProcessMessages;
until not animate;
end;

procedure StartAnimation;
begin
animate:=true;
mForm.FPStimer.Enabled:=true;
MainLoop;
end;

procedure StopAnimation;
begin
animate:=false;
mForm.FPStimer.Enabled:=false;
end;

procedure TmForm.FormCreate(Sender: TObject);
begin
if not InitOpenGL then halt(1);
fullscr:=tFullScreen.Create;

SetupGL(handle, ClientWidth, ClientHeight);

dims:=inttostr(clientwidth)+'x'+inttostr(clientheight);
renderer:=StrPas(PChar(glGetString(GL_renderer)));
vendor:=StrPas(PChar(glGetString(GL_vendor)));
gcard:='GoldenGlobe ** '+dims+' fps: ';
caption:=gcard;

sh:=true; ref:=true;

Application.OnMinimize:= AppMinimize;
Application.OnRestore:= AppRestore;
StartTimer.Enabled:=true;
end;

procedure TmForm.AppMinimize(Sender: TObject);
begin
 Animate:=false;
 mForm.FPStimer.Enabled:=false;
end;

procedure TmForm.AppRestore(Sender: TObject);
begin
 StartAnimation;
end;

procedure TmForm.FormResize(Sender: TObject);
begin
resizeviewport(ClientWidth, ClientHeight);
dims:=inttostr(clientwidth)+'x'+inttostr(clientheight);
gcard:='GoldenGlobe >>---> '+dims+' Fps: ';
end;

procedure TmForm.StartTimerTimer(Sender: TObject);
begin
StartTimer.Enabled:=false;
StartAnimation;
end;

procedure TmForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
StopAnimation;
DeInitScene;
fullscr.Free;
Action:=caFree;
end;

procedure TmForm.FormDestroy(Sender: TObject);
begin
DestroyRenderingContext(hrc);
CloseOpenGL;
end;

procedure TmForm.FPStimerTimer(Sender: TObject);
begin
caption:=gcard+inttostr(fps);
fps:=0;
end;

procedure TmForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
case upcase(key) of
  #27: begin StopAnimation;close;end;
  'S': sh:=not sh;
  'R': ref:=not ref;
  #32: if not fullscr.Enabled then
        begin
        StopAnimation;
        DeInitScene;
        DestroyRenderingContext(hrc);

        BorderStyle:=bsNone; //this line destroys and recreates the window & its handle so call it before fs.create
        fullscr.GoFullScreen(fullscr.MakeResolution(800, 600, 32), handle, true);//call AFTER setting BorderStyle.
        ShowWindow(Handle, SW_HIDE);//this line avoids the taskbar to be visible
        ShowWindow(Handle, SW_SHOWMAXIMIZED);
        SetForegroundWindow(Handle);
        SetupGL(handle, Width, Height); //calls InitScene
        StartAnimation;
       end
      else
       begin
       StopAnimation;
       DeInitScene;
       DestroyRenderingContext(hrc);

       fullscr.Restore;//call before setting BorderStyle.
       BorderStyle:=bsSizeable;
       ShowWindow(Handle, SW_HIDE);
       ShowWindow(Handle, SW_RESTORE);
       SetupGL(handle, ClientWidth, ClientHeight);
       StartAnimation;
       end;
  end;
end;


end.
